home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / jmstring.zip / JMSTRING.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  2KB  |  84 lines
  1. unit jmstring ;
  2. interface
  3. uses dos, crt ;
  4.  
  5. const
  6.    space = ' ' ;
  7.    radixPoint = '.' ;
  8.  
  9. type
  10.    charSet        = set of Char ;
  11.  
  12. var
  13.    UpperAlphas,
  14.    LowerAlphas,
  15.    Alphas,
  16.    reals,
  17.    Numerics       : charSet ;
  18.  
  19. function compact    (s:string):string ;
  20. function toUpper    (s:string):string ;
  21. function toLower    (s:string):string ;
  22. function isType     (s:string;c:charset):boolean ;
  23.  
  24. implementation
  25.  
  26. function compact (s:string):string ;
  27. (* --------------------------------- *)
  28. (* removes multiple spaces from s    *)
  29. (* --------------------------------- *)
  30. var l,i : byte ;
  31. begin
  32.    for i := 1 to length (s) do
  33.       while ((s[i]=space) and (s[i+1]=space)) do
  34.          delete (s,i+1,1) ;
  35.    compact := s
  36. end ; (* function compact *)
  37.  
  38. function toUpper (s:string):string ;
  39. (* --------------------------------- *)
  40. (* converts alphas in s to uppercase *)
  41. (* --------------------------------- *)
  42. var l,i : byte ;
  43. begin
  44.    l := length (s) ;
  45.    for i := 1 to l do
  46.       s[i]:=upCase(s[i]) ;
  47.    toUpper := s
  48. end ; (* function toUpper *)
  49.  
  50. function toLower (s:string):string ;
  51. (* --------------------------------- *)
  52. (* converts alphas in s to lowercase *)
  53. (* --------------------------------- *)
  54. var l,i : byte ;
  55. begin
  56.    l := length (s) ;
  57.    for i := 1 to l do
  58.       if (s[i] in upperAlphas) then s[i]:=chr(ord(s[i])+32) ;
  59.    toLower := s
  60. end ; (* function toLower *)
  61.  
  62. function isType (s:string;c:charset):boolean ;
  63. (* --------------------------------- *)
  64. (* returns true if all of s is in c  *)
  65. (* --------------------------------- *)
  66. var temp : boolean ;
  67.     l,i  : byte ;
  68. begin
  69.    l := length (s) ;
  70.    temp := true ;
  71.    for i := 1 to l do
  72.       temp := temp and (s[i] in c) ;
  73.    isType := temp
  74. end ; (* function isType *)
  75.  
  76. begin
  77.    upperAlphas := ['A'..'Z'] ;
  78.    lowerAlphas := ['a'..'z'] ;
  79.    numerics    := ['0'..'9'] ;
  80.    reals       := numerics + [radixPoint] ;
  81.    Alphas      := upperAlphas + lowerAlphas
  82. end.
  83.  
  84.